home *** CD-ROM | disk | FTP | other *** search
- ;;; -*- Mode:Lisp; Package:Weyli; Base:10; Lowercase:T; Syntax:Common-Lisp -*-
- ;;; ===========================================================================
- ;;; Algebraic Domains
- ;;; ===========================================================================
- ;;; (c) Copyright 1989, 1991 Cornell University
-
- ;;; $Id: algebraic-domains.lisp,v 2.13 1991/10/21 21:58:45 rz Exp $
-
- (in-package "WEYLI")
-
- (defclass set (domain)
- ((equal-function :accessor set-elt-equal
- :initarg :equality
- :initform #'=))
- (:documentation "A class for finite, unordered sets"))
-
- (defgeneric = (x y))
- (defgeneric make-element (domain obj &rest rest))
-
- ;; Define-opeartions for sets is in sets.lisp
-
- (defclass SemiGroup (set)
- ())
-
- (define-operations semigroup
- (times (element self) (element self)) -> (element self)
- (expt (element self) positive-integer) -> (element self))
-
- (defgeneric times (x y))
- (defgeneric expt (x y))
-
- (defclass Monoid (semigroup)
- ())
-
- (define-operations Monoid
- (one self) -> (element monoid)
- (1? (element self)) -> Boolean
- (expt (element self) integer) -> (element self))
-
- (defgeneric one (x))
- (defgeneric 1? (x))
-
- (defclass group (monoid)
- ())
-
- (define-operations group
- (recip (element self)) -> (element self)
- (expt (element self) Integer) -> (element self))
-
- (defgeneric recip (x))
-
- (defclass abelian-semigroup (set)
- ())
-
- (define-operations abelian-semigroup
- (plus (element self) (element self)) -> (element self)
- (times Integer (element self)) -> (element self))
-
- (defgeneric plus (x y))
-
- (defclass abelian-monoid (abelian-semigroup)
- ())
-
- (define-operations abelian-monoid
- (zero self) -> (element self)
- (0? (element self)) -> Boolean
- (times integer (element self)) -> (element self))
-
- (defgeneric zero (x))
- (defgeneric 0? (x))
-
- (defclass ordered-abelian-monoid (abelian-monoid ordered-set)
- ())
-
- (defclass abelian-group (abelian-monoid)
- ())
-
- (define-operations abelian-group
- (minus (element self)) -> (element self)
- (difference (element self) (element self)) -> (element self)
- (times integer (element self)) -> (element self))
-
- (defgeneric minus (x))
- (defgeneric difference (x y))
-
- (defclass ordered-abelian-group (abelian-group ordered-set)
- ())
-
- (defclass rng (semigroup abelian-group)
- ())
-
- (defclass simple-ring (rng monoid)
- ((characteristic :initform 0
- :initarg :characteristic
- :reader ring-characteristic)))
-
- (defmethod characteristic ((r rng))
- (ring-characteristic r))
-
- (define-operations simple-ring
- (one self) -> (element self)
- (1? (element self)) -> (element self)
- (recip (element self)) -> (element self))
-
- (defclass has-coefficient-domain ()
- ((coefficient-domain :initform nil
- :initarg :coefficient-domain
- :reader coefficient-domain)))
-
- (defvar *coefficient-domain* ()
- "Within the context of a polynomial operation, the coefficient domain")
-
- (defmethod %bind-dynamic-domain-context :around
- ((domain has-coefficient-domain) function)
- (with-slots (coefficient-domain) domain
- (let ((*coefficient-domain* coefficient-domain))
- (call-next-method domain function))))
-
- (defclass module (abelian-group has-coefficient-domain)
- ())
-
- (defclass algebra (module semigroup)
- ())
-
- (defclass ring (algebra simple-ring)
- ()
- ;; Also has the distributive law
- )
-
- (defclass ordered-ring (ring ordered-set)
- ())
-
- (defgeneric > (x y))
- (defgeneric < (x y))
-
- (defclass integral-domain (ring)
- ()
- ;; No zero divisors
- )
-
- (define-operations integral-domain
- ;; Unit coefficient associate
- (unit-normal (element self)) ->
- (values (element self) (element self) (element self))
- (associates? (element self) (element self)) -> Boolean
- (unit? (element self)) -> Boolean)
-
- (defclass gcd-domain (integral-domain)
- ())
-
- (define-operations gcd-domain
- (gcd (element self) (element self)) -> (element self)
- (lcm (element self) (element self)) -> (element self))
-
- (defgeneric gcd (x y))
- (defgeneric lcm (x y))
-
- (defclass unique-factorization-domain (gcd-domain)
- ())
-
- (define-operations unique-factorization-domain
- (prime? (element self)) -> Boolean
- (square-free (element self)) -> (element (factored-form self))
- (factor (element self)) -> (element (factored-form self)))
-
- (defclass euclidean-domain (gcd-domain)
- ())
-
- (define-operations euclidean-domain
- (sizelp (element self) (element self)) -> boolean
- (divide (element self) (element self)) -> (values (element self) (element self))
- (quotient (element self) (element self)) -> (element self)
- (remainder (element self) (element self)) -> (element self))
-
- (defclass skew-field (ring)
- ())
-
- (defclass field (euclidean-domain unique-factorization-domain skew-field)
- ())
-
- (define-operations field
- (quotient (element self) (element self)) -> (element self)
- (recip (element self)) -> (element self))
-
- (defclass finite-field (field finite-set)
- ())
-
- (defclass ordered-field (field ordered-set)
- ())
-
- (defclass algebraic-extension (ring)
- ())
-
- (defclass simple-field-extension (algebraic-extension field)
- ())
-
- ;; A domain that has a dimension
- (defclass dimensional-domain (domain)
- ((dimension :initform nil
- :initarg :dimension
- :reader dimension)))
-
- (defclass free-module (module dimensional-domain)
- ())
-
- (defclass vector-space (free-module)
- ()
- ;; Coefficient domain must be a field
- )
-
- (defclass projective-space (free-module)
- ())
-
- (defclass differential-ring (ring)
- ())
-
- (define-operations differential-ring
- (deriv (element self)) -> (element self))
-
- (defclass quotient-ring (domain)
- ())
-
- ;;; Concrete classes
-
- ;; Lisp numbers
-
- (defclass lisp-numbers (domain)
- ())
-
- ;; Sets
-
- (defclass mutable-set (set)
- ()
- (:documentation "Sets built from this class can be modified"))
-
- (defclass has-comparison ()
- ((compare-function :accessor set-elt-greaterp
- :initarg :compare-function))
- )
-
- (defclass ordered-set (set has-comparison)
- ())
-
- (defclass finite-set (set)
- ())
-
- (defclass set-element (domain-element)
- ((key :reader element-key
- :initarg :key)))
-
- (defclass set-element1 (set-element)
- ())
-
- (defclass set-element2 (set-element)
- ((value :accessor element-value
- :initarg :value)))
-
- (defclass set-elements-as-singletons (set)
- ())
-
- (defclass set-elements-as-pairs (set)
- ())
-
- (defclass set-with-element-list (set)
- ((elements :accessor set-element-list
- :initform (list nil)
- :initarg :elements)))
-
- (defclass mutable-set-with-element-list (set-with-element-list mutable-set)
- ())
-
- (defclass set-with-sorted-element-list (ordered-set set-with-element-list)
- ())
-
- (defclass mutable-set-with-sorted-element-list (ordered-set mutable-set-with-element-list)
- ())
-
- ;; The intiable sets classes
-
- (defclass simple-set (mutable-set-with-element-list set-elements-as-singletons)
- ())
-
- (defclass set-of-pairs (mutable-set-with-element-list set-elements-as-pairs)
- ())
-
- (defclass ordered-simple-set
- (mutable-set-with-sorted-element-list set-elements-as-singletons)
- ())
-
- (defclass ordered-set-of-pairs
- (mutable-set-with-sorted-element-list set-elements-as-pairs)
- ())
-
-
- ;; Rational integers
-
- (defclass rational-integers (gcd-domain caching-zero-and-one ordered-set)
- ())
-
- (defclass rational-integer (domain-element)
- ((value :initarg :value
- :accessor integer-value)))
-
- ;; GFp
-
- (defclass GFp (field)
- ())
-
- (defclass GFq (GFp)
- ((degree :initarg :degree
- :reader field-degree)))
-
- (defclass GFp-element (domain-element)
- ((value :reader gfp-value
- :initarg :value)))
-
- (defclass GF2^n (GFq)
- ((reduction-table :initarg :reduction-table
- :reader GFp-reduction-table)))
-
- (defclass GFm (rng)
- ())
-
- (defclass GFm-element (domain-element)
- ((value :initarg :value)
- (modulus :initarg :modulus)))
-
- (defclass simple-finite-field (field)
- ())
-
- ;; Bigfloat
-
- (defclass real-numbers (ordered-field)
- ((precision :initform 28
- :initarg :precision
- :accessor fp-precision)))
-
- (defclass bigfloat (domain-element)
- ((mantissa :accessor bigfloat-mantissa
- :initarg :mantissa)
- (exponent :accessor bigfloat-exponent
- :initarg :exponent)))
-
- ;; Float
-
- (defclass floating-point-numbers (ordered-field)
- ())
-
- (defclass complex-numbers (algebraic-extension field)
- ())
-
- ;; Quotient Fields
-
- (defclass Quotient-Field (field)
- ((ring :initform nil :initarg :ring
- :reader QF-ring)
- (zero :initform nil)
- (one :initform nil)))
-
- (defclass quotient-element (domain-element)
- ((numerator :accessor qo-numerator
- :initarg :numerator)
- (denominator :accessor qo-denominator
- :initarg :denominator)))
-
- ;; Rational Numbers
-
- (defclass rational-numbers (field ordered-set)
- ())
-
- (defclass rational-number (quotient-element)
- ())
-
- ;; Polynomials
-
- ;; This is just the root of the polynomial structural type hierarchy.
- ;; It needs to be at the beginning of this file.
- (defclass polynomial (domain-element)
- ())
-
- ;; These are the pieces that are common to all polynomial domains and
- ;; polynomial representations.
- (defclass has-ring-variables ()
- ((variables :initform nil
- :initarg :variables
- :reader ring-variables)))
-
- ;;FIXTHIS I don't think this is quite right. I.e. Its not really a
- ;; GCD domain for any coefficient domain.
- (defclass polynomial-ring (gcd-domain module has-ring-variables)
- ())
-
- ;; Multivariate Polynomial rings need some structure to manage the their
- ;; variables. This class provides hash tables and accessor methods of
- ;; this purpose.
- (defclass variable-hash-table (has-ring-variables)
- ((variable-hash-table :initform nil
- :accessor variable-hash-table)
- (variable-table :initform nil
- :accessor variable-index-table)))
-
- ;; Univariate polynomials only have a single variable, but they still
- ;; need all the accessing methods of the multivariate structures.
- (defclass single-variable-hash-table (has-ring-variables)
- ((variable :initform nil
- :initarg :variable
- :accessor svht-variable)
- (variable-plist :initform nil
- :accessor svht-variable-plist)))
-
- ;; It is often useful to cache the values of zero and one since they are
- ;; often needed. Need to include the class domain here to make
- ;; caching... more specific than just domain.
- (defclass caching-zero-and-one (domain)
- ((zero)
- (one)))
-
-
- ;; Multivariate polynomials
-
- (defclass multivariate-polynomial-ring
- (polynomial-ring variable-hash-table caching-zero-and-one)
- ())
-
- ;; The following are the two different representation that are used.
- ;; An mpolynomial uses a recursive structure in the variables, while a
- ;; epolynomial is an expanded representation that uses exponent vectors.
-
- (defclass mpolynomial (polynomial)
- ((form :accessor poly-form
- :initarg :form)))
-
- (defclass epolynomial (polynomial)
- ((form :accessor poly-form
- :initarg :form)
- (compare-function :accessor compare-function
- :initarg :compare-function)))
-
- ;; Univariate polynomials
-
- (defclass univariate-polynomial-ring
- (polynomial-ring single-variable-hash-table caching-zero-and-one)
- ())
-
- (defclass upolynomial (polynomial)
- ((coef-list :accessor poly-form
- :initarg :form)))
-
- ;; Rational functions
-
- (defclass rational-function-field (quotient-field)
- ())
-
- (defclass rational-function (quotient-element)
- ())
-
- ;; Morphisms
-
- (defclass morphism ()
- ((domain :reader morphism-domain
- :initarg :domain)
- (map :reader morphism-map
- :initarg :map)
- (range :reader morphism-range
- :initarg :range))
- )
-
- (defclass homomorphism (morphism)
- ())
-
- (defclass automorphism (homomorphism)
- ())
-
- ;; Differential domains
-
- (defclass differential-polynomial-ring
- (multivariate-polynomial-ring differential-ring)
- ())
-
- ;; Algebraic Extensions
-
- (defclass algebraic-extension-ring
- (algebraic-extension multivariate-polynomial-ring)
- ())
-
- (defclass algebraic-object (mpolynomial)
- ())
-
-
- ;; Direct Sums
-
- ;; These are the root classes. Classes like DIRECT-SUM-SEMIGROUP are
- ;; created in the direct-sum.lisp file along with several support
- ;; methods.
-
- (defclass direct-sum (domain tuple) ())
-
- (defclass direct-sum-element (domain-element tuple) ())
-
-
- ;; Vector Spaces
-
- (defclass free-module-element (domain-element tuple)
- ())
-
- (defclass vector-space-element (free-module-element)
- ())
-
- ;; This optimization is included because lisp vectors are used as
- ;; exponents in the expanded polynomial representation.
- (defclass lisp-vector-space (vector-space)
- ())
-
- (defclass lisp-vector (vector-space-element)
- ())
-
- ;; Projective spaces
-
- (defclass projective-space-element (vector-space-element)
- ())
-
- ;; Matrices
-
- ;; This is is the domain of all matrices over a given ring.
- (defclass matrix-space (module) ())
-
- (defclass GL-n (group has-coefficient-domain dimensional-domain)
- ()
- (:documentation "General linear group"))
-
- (defclass PSL-n (GL-n)
- ())
-
- (defclass SL-n (PSL-n)
- ())
-
- (defclass O-n (GL-n)
- ())
-
- (defclass SO-n (O-n)
- ())
-
- (defclass matrix-element (domain-element)
- ((value :initarg :value
- :reader matrix-value)))
-
- (defclass matrix-space-element (matrix-element)
- ((dimension1 :initarg :dimension1)
- (dimension2 :initarg :dimension2)))
-
- (defclass GL-n-element (matrix-element)
- ())
-
- (defclass PSL-n-element (GL-n-element)
- ())
-
- (defclass SL-n-element (PSL-n-element)
- ())
-
- (defclass O-n-element (GL-n-element)
- ())
-
- (defclass SO-n-element (O-n-element)
- ())
-